INTRODUÇÃO
Este estudo tem como objetivo identificar os fatores que influenciam na presença de doenças do coração. A princípio, iremos fazer uma análise descritiva para termos uma visão mais detalhada do banco e, em seguida iremos fazer uma Análise de Regressão Logística, pois a variável respota diagnóstico (target) é uma variável binária (do tipo 0 ou 1, que nesse caso, representa saudável (0) ou doente (1)).
O banco de dados “heart” possui 303 observações e 14 variáveis.
Descrição do banco heart:
- age (Idade): variando de 29 a 77 anos;
- sex (sexo): Homem (1) e Mulher (0);
- cp (tipo de dor no peito): varia 0 a 3, sendo angina típica, angina atípica, sem dor anginal e assintomático, respectivamente;
- trestbps (pressão arterial em repouso): medida em mm Hg na admissão no hospital;
- chol (nível de colesterol sérico): medida em mg / dl;
- fbs (concentração de açúcar no sangue em jejum & gt): 1 = verdadeiro; 0 = falso, 120 mg / dl;
- restecg (resultados eletrocardiográficos em repouso): 0 a 2, sendo Normal, com onda ST-T anormal e mostrando provável (ou definida) hipertrofia do ventrículo esquerdo, respectivamente ;
- thalach: frequência cardíaca máxima alcançada;
- exang (angina induzida pelo exercício): 1 = sim; 0 = não;
- oldpeak: Depressão ST induzida por exercício em relação ao repouso;
- slope (a inclinação do segmento ST do pico do exercício): varia de 0 a 2, Inclinado para cima, Plano e Inclinado para baixo, respectivamente;
- ca (número de vasos principais (0-4) coloridos por flourosopy): varia de 0 a 4;
- thal (Talassemias): 3 = normal; 6 = defeito fixo; 7 = defeito reversível;
- target (objetivo/diagnóstico): 0 = Saudável; 1 = Doente.
Podemos observar atráves do gráfico que não há dados faltantes.
Os pacientes possuem pressão arterial média de 131,62, com mediana igual a 130. Além disso, a pressão desses pacientes da amostra possuem um valor mínimo de 94 e máximo de 200.
Shapiro-Wilk normality test
data: heart$trestbps
W = 0.96592, p-value = 1.458e-06
Após fazermos o teste de Shapiro Wilk, verificamos que os dados de pressão arterial não possuem distribuição Normal.Adotamos um nível de significância de 5%.
Os pacientes possuem colesterol médio de 246,26, com mediana igual a 240. Além disso, o nível de colesterol desses pacientes da amostra possuem um valor mínimo de 126 e máximo de 564.
Adicionar comentário
Shapiro-Wilk normality test
data: heart$chol
W = 0.94688, p-value = 5.365e-09
Pelo teste de Shapiro Wilk, podemos afirmar que a distribuição desses dados, também, não é Normal.
Os pacientes possuem uma frequência cardíaca média de 149,65; com mediana de 153 e; frequência cardíaca mínima de 71 e máxima de 202.
Shapiro-Wilk normality test
data: heart$thalach
W = 0.97632, p-value = 6.621e-05
O teste de Shapiro Wilk mostra que os dados dessa variável não possui distribuição normal.
Os pacientes possuem uma Depressão ST induzida por exercício média de 1,04; com mediana de 0,8 e; mínima de 0 e máxima de 6,2.
Shapiro-Wilk normality test
data: heart$oldpeak
W = 0.84418, p-value < 2.2e-16
Os dados da variável oldpeak não são normais.
Call: glm(formula = heart$target ~ heart$age + heart$sex + heart$cp +
heart$trestbps + heart$chol + heart$fbs + heart$restecg +
heart$thalach + heart$exang + heart$oldpeak + heart$slope +
heart$ca + heart$thal, family = "binomial", data = heart)
Coefficients:
(Intercept) heart$age heart$sexHomem
0.179045 0.027819 -1.862297
heart$cp1 heart$cp2 heart$cp3
0.864708 2.003186 2.417107
heart$trestbps heart$chol heart$fbsVerdadeiro
-0.026162 -0.004291 0.445666
heart$restecg1 heart$restecg2 heart$thalach
0.460582 -0.714204 0.020055
heart$exangSim heart$oldpeak heart$slope1
-0.779111 -0.397174 -0.775084
heart$slope2 heart$ca1 heart$ca2
0.689965 -2.342301 -3.483178
heart$ca3 heart$ca4 heart$thal1
-2.247144 1.267961 2.637558
heart$thal2 heart$thal3
2.367747 0.915115
Degrees of Freedom: 302 Total (i.e. Null); 280 Residual
Null Deviance: 417.6
Residual Deviance: 179.6 AIC: 225.6
REGRESSÃO LOGÍSTICA MÚLTIPLA
“A técnica de regressão logística é uma ferramenta estatística utilizada nas análises preditivas. O interesse em mensurar a probabilidade de um evento ocorrer é extremamente relevante em diversas áreas…”. Nesse estudo, gostaríamos de saber quais são os fatores que mais influenciam na presença de doenças do coração.
O MODELO
O modelo de regressão logística é utilizado quando a variável dependente é binária. Então, primeiramente, verificamos que o tipo da variável resposta era uma binomial do tipo Saudável = 0 e Doente = 1. Para a estimação dos coeficientes das variáveis independentes, serão utilizados o valor logit. Então, o modelo inicial ficou assim:
Diagnóstico = 0.179045 + 0.027819 x Age - 1.862297 x (Sex=Homem) + 0.864708 x (CP=1) + 2.003186 x (CP=2) + 2.417107 x (CP=3) - 0.026162 x trestbps - 0.004291 x chol + 0.445666 x (fbs=verdadeiro) + 0.460582 x (restecg=1) - 0.714204 x (restecg=2) + 0.020055 x thalach - 0.779111 x (exang=Sim) - 0.397174 x oldpeak - 0.775084 x (slope=1) + 0.689965 x (slope=2) - 2.342301 x (ca=1) - 3.483178 x (ca=2) - 2.247144 x (ca=3) + 1.267961 x (ca=4) + 2.637558 x (thal=1) + 2.367747 x (thal=2) + 0.915115 x (thal=3)
Call:
glm(formula = heart$target ~ heart$age + heart$sex + heart$cp +
heart$trestbps + heart$chol + heart$fbs + heart$restecg +
heart$thalach + heart$exang + heart$oldpeak + heart$slope +
heart$ca + heart$thal, family = "binomial", data = heart)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.9459 -0.2738 0.1012 0.4515 3.1248
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.179045 3.705420 0.048 0.961461
heart$age 0.027819 0.025428 1.094 0.273938
heart$sexHomem -1.862297 0.570844 -3.262 0.001105 **
heart$cp1 0.864708 0.578000 1.496 0.134645
heart$cp2 2.003186 0.529356 3.784 0.000154 ***
heart$cp3 2.417107 0.719242 3.361 0.000778 ***
heart$trestbps -0.026162 0.011943 -2.191 0.028481 *
heart$chol -0.004291 0.004245 -1.011 0.312053
heart$fbsVerdadeiro 0.445666 0.587977 0.758 0.448472
heart$restecg1 0.460582 0.399615 1.153 0.249089
heart$restecg2 -0.714204 2.768873 -0.258 0.796453
heart$thalach 0.020055 0.011859 1.691 0.090820 .
heart$exangSim -0.779111 0.451839 -1.724 0.084652 .
heart$oldpeak -0.397174 0.242346 -1.639 0.101239
heart$slope1 -0.775084 0.880495 -0.880 0.378707
heart$slope2 0.689965 0.947657 0.728 0.466568
heart$ca1 -2.342301 0.527416 -4.441 8.95e-06 ***
heart$ca2 -3.483178 0.811640 -4.292 1.77e-05 ***
heart$ca3 -2.247144 0.937629 -2.397 0.016547 *
heart$ca4 1.267961 1.720014 0.737 0.461013
heart$thal1 2.637558 2.684285 0.983 0.325808
heart$thal2 2.367747 2.596159 0.912 0.361759
heart$thal3 0.915115 2.600380 0.352 0.724901
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 417.64 on 302 degrees of freedom
Residual deviance: 179.63 on 280 degrees of freedom
AIC: 225.63
Number of Fisher Scoring iterations: 6
VARIÁVEIS SIGNIFICATIVAS
Verificamos quais eram as variáveis mais siginificativas no modelo ao nível de significância de 5%, são elas: Sexo Masculino, o tipo de dor no peito (cp = 2 e 3, ou seja, sem dor anginal e assintomático), a pressão arterial medida em repouso e, o número de vasos principais coloridos por flourosopy (ca = 1, 2 e 3).
2.5 % 97.5 %
(Intercept) -6.520353992 7.612221779
heart$age -0.021711585 0.078569023
heart$sexHomem -3.033827937 -0.781456905
heart$cp1 -0.241473349 2.046240514
heart$cp2 1.000309167 3.089929630
heart$cp3 1.061674680 3.903354655
heart$trestbps -0.050337381 -0.003275065
heart$chol -0.012556122 0.004308513
heart$fbsVerdadeiro -0.689249100 1.627272971
heart$restecg1 -0.319484444 1.255945020
heart$restecg2 -5.515509745 3.425174195
heart$thalach -0.002587503 0.044378501
heart$exangSim -1.671509283 0.109615019
heart$oldpeak -0.889175726 0.065838403
heart$slope1 -2.557985380 0.923381067
heart$slope2 -1.240273929 2.519895332
heart$ca1 -3.422221252 -1.342555106
heart$ca2 -5.166226465 -1.968400734
heart$ca3 -4.289449204 -0.551436689
heart$ca4 -2.045138743 4.990919078
heart$thal1 -2.045793732 7.625672944
heart$thal2 -2.219334545 7.060581121
heart$thal3 -3.653859155 5.642360044
[1] 179.6307
[1] 320.0278
AJUSTE DO MODELO
A deviance do modelo foi de 179,6307 e foi menor que o valor do quiquadrado que foi de 320,0278. Portanto, ao nível de significância de 5%, podemos dizer que o modelo está bem ajustado.
Acima, também podemos observar os intervalos de confiança dos coeficientes estimados das variáveis explicativas. Os intervalos que não passam pelo zero são os das variáveis significativas. E podemos ver que são exatamente as mesmas variáveis significativas que descrevemos, anteriormente.
Hosmer and Lemeshow goodness of fit (GOF) test
data: heart$target, fitted(target_logit)
X-squared = 303, df = 8, p-value < 2.2e-16
TESTE DE HOSMER-LEMESHOW
O teste de Hosmer-Lemeshow é para verificar se as proporções observadas e esperadas são as mesmas ao longo da amostra. Como o p-valor foi menor que 0,05, rejeita-se a hipótese nula, ou seja, o modelo está tendo problemas.
Start: AIC=225.63
heart$target ~ heart$age + heart$sex + heart$cp + heart$trestbps +
heart$chol + heart$fbs + heart$restecg + heart$thalach +
heart$exang + heart$oldpeak + heart$slope + heart$ca + heart$thal
Df Deviance AIC
- heart$restecg 2 181.09 223.09
- heart$fbs 1 180.21 224.21
- heart$chol 1 180.62 224.62
- heart$age 1 180.84 224.84
<none> 179.63 225.63
- heart$oldpeak 1 182.44 226.44
- heart$exang 1 182.59 226.59
- heart$thalach 1 182.63 226.63
- heart$trestbps 1 184.67 228.67
- heart$slope 2 189.03 231.03
- heart$thal 3 193.33 233.33
- heart$sex 1 191.44 235.44
- heart$cp 3 201.05 241.05
- heart$ca 4 219.67 257.67
Step: AIC=223.09
heart$target ~ heart$age + heart$sex + heart$cp + heart$trestbps +
heart$chol + heart$fbs + heart$thalach + heart$exang + heart$oldpeak +
heart$slope + heart$ca + heart$thal
Df Deviance AIC
- heart$fbs 1 181.70 221.70
- heart$age 1 182.15 222.15
- heart$chol 1 182.59 222.59
<none> 181.09 223.09
- heart$oldpeak 1 183.95 223.95
- heart$exang 1 184.06 224.06
- heart$thalach 1 184.09 224.09
+ heart$restecg 2 179.63 225.63
- heart$trestbps 1 186.81 226.81
- heart$slope 2 191.03 229.03
- heart$thal 3 194.07 230.07
- heart$sex 1 193.62 233.62
- heart$cp 3 202.44 238.44
- heart$ca 4 221.87 255.87
Step: AIC=221.7
heart$target ~ heart$age + heart$sex + heart$cp + heart$trestbps +
heart$chol + heart$thalach + heart$exang + heart$oldpeak +
heart$slope + heart$ca + heart$thal
Df Deviance AIC
- heart$age 1 182.72 220.72
- heart$chol 1 183.09 221.09
<none> 181.70 221.70
- heart$exang 1 184.42 222.42
- heart$thalach 1 184.77 222.77
- heart$oldpeak 1 184.92 222.92
+ heart$fbs 1 181.09 223.09
+ heart$restecg 2 180.21 224.21
- heart$trestbps 1 186.98 224.98
- heart$slope 2 191.29 227.29
- heart$thal 3 194.93 228.93
- heart$sex 1 193.84 231.84
- heart$cp 3 205.00 239.00
- heart$ca 4 221.91 253.91
Step: AIC=220.72
heart$target ~ heart$sex + heart$cp + heart$trestbps + heart$chol +
heart$thalach + heart$exang + heart$oldpeak + heart$slope +
heart$ca + heart$thal
Df Deviance AIC
- heart$chol 1 183.84 219.84
<none> 182.72 220.72
- heart$thalach 1 184.94 220.94
- heart$exang 1 185.55 221.55
+ heart$age 1 181.70 221.70
+ heart$fbs 1 182.15 222.15
- heart$oldpeak 1 186.35 222.35
- heart$trestbps 1 187.13 223.13
+ heart$restecg 2 181.39 223.39
- heart$slope 2 191.88 225.88
- heart$thal 3 195.97 227.97
- heart$sex 1 195.41 231.41
- heart$cp 3 206.77 238.77
- heart$ca 4 223.08 253.08
Step: AIC=219.84
heart$target ~ heart$sex + heart$cp + heart$trestbps + heart$thalach +
heart$exang + heart$oldpeak + heart$slope + heart$ca + heart$thal
Df Deviance AIC
- heart$thalach 1 185.78 219.78
<none> 183.84 219.84
+ heart$chol 1 182.72 220.72
- heart$exang 1 186.79 220.79
+ heart$age 1 183.09 221.09
+ heart$fbs 1 183.37 221.37
- heart$oldpeak 1 187.80 221.80
+ heart$restecg 2 182.07 222.07
- heart$trestbps 1 188.64 222.64
- heart$slope 2 193.51 225.51
- heart$thal 3 197.65 227.65
- heart$sex 1 195.45 229.45
- heart$cp 3 208.32 238.32
- heart$ca 4 225.19 253.19
Step: AIC=219.79
heart$target ~ heart$sex + heart$cp + heart$trestbps + heart$exang +
heart$oldpeak + heart$slope + heart$ca + heart$thal
Df Deviance AIC
<none> 185.78 219.78
+ heart$thalach 1 183.84 219.84
+ heart$chol 1 184.94 220.94
+ heart$fbs 1 185.24 221.24
- heart$exang 1 189.58 221.58
+ heart$age 1 185.68 221.68
+ heart$restecg 2 183.99 221.99
- heart$trestbps 1 190.08 222.08
- heart$oldpeak 1 190.37 222.37
- heart$thal 3 199.82 227.82
- heart$sex 1 196.32 228.32
- heart$slope 2 198.69 228.69
- heart$cp 3 213.15 241.15
- heart$ca 4 230.35 256.35
Call: glm(formula = heart$target ~ heart$sex + heart$cp + heart$trestbps +
heart$exang + heart$oldpeak + heart$slope + heart$ca + heart$thal,
family = "binomial", data = heart)
Coefficients:
(Intercept) heart$sexHomem heart$cp1 heart$cp2 heart$cp3
3.30454 -1.63154 1.03058 2.22015 2.55944
heart$trestbps heart$exangSim heart$oldpeak heart$slope1 heart$slope2
-0.02211 -0.85234 -0.47970 -0.90675 0.70078
heart$ca1 heart$ca2 heart$ca3 heart$ca4 heart$thal1
-2.35513 -3.10939 -2.26756 1.23217 2.62410
heart$thal2 heart$thal3
2.36301 0.91673
Degrees of Freedom: 302 Total (i.e. Null); 286 Residual
Null Deviance: 417.6
Residual Deviance: 185.8 AIC: 219.8
MÉTODO STEPWISE
O método Stepwise nos auxilia a selecionar as variáveis mais importantes para nosso modelo. Este método, por sua vez, utiliza o Critério de Informação de Akaike (AIC - Akaike Information Criterion) na combinação das variáveis dos diversos modelos simulados para selecionar o modelo mais ajustado. Quanto menor o AIC, melhor o ajuste do modelo. Utilizaremos neste modelo a direção both.
ENCONTRANDO O MELHOR MODELO
Após analisarmos os AIC’s, escolhemos o menor para usar, com valor de 219,8 e Residual Deviance de 185.8. Daí, o novo modelo ficou assim:
Diagnóstico = 3.30454 - 1.63154 x (sex = Homem) + 1.03058 x (CP=1) + 2.22015 x (CP=2) + 2.55944 x (CP=3) - 0.02211 x trestbps - 0.85234 x (exang=Sim) - 0.47970 x oldpeak - 0.90675 x (slope=1) + 0.70078 x (slope=2) - 2.35513 x (ca=1) - 3.10939 x (ca=2) - 2.26756 x (ca=3) + 1.23217 x (ca=4) + 2.62410 x (thal=1) + 2.36301 x (thal=2) + 0.91673 x (thal=3)
Call: glm(formula = heart$target ~ heart$sex + heart$cp + heart$trestbps +
heart$exang + heart$oldpeak + heart$slope + heart$ca + heart$thal,
family = "binomial", data = heart)
Coefficients:
(Intercept) heart$sexHomem heart$cp1 heart$cp2 heart$cp3
3.30454 -1.63154 1.03058 2.22015 2.55944
heart$trestbps heart$exangSim heart$oldpeak heart$slope1 heart$slope2
-0.02211 -0.85234 -0.47970 -0.90675 0.70078
heart$ca1 heart$ca2 heart$ca3 heart$ca4 heart$thal1
-2.35513 -3.10939 -2.26756 1.23217 2.62410
heart$thal2 heart$thal3
2.36301 0.91673
Degrees of Freedom: 302 Total (i.e. Null); 286 Residual
Null Deviance: 417.6
Residual Deviance: 185.8 AIC: 219.8
Resultados
=============================================
Dependent variable:
---------------------------
target
---------------------------------------------
sexHomem -1.632***
(0.527)
cp1 1.031*
(0.565)
cp2 2.220***
(0.517)
cp3 2.559***
(0.702)
trestbps -0.022**
(0.011)
exangSim -0.852*
(0.437)
oldpeak -0.480**
(0.231)
slope1 -0.907
(0.828)
slope2 0.701
(0.897)
ca1 -2.355***
(0.499)
ca2 -3.109***
(0.754)
ca3 -2.268**
(0.901)
ca4 1.232
(1.622)
thal1 2.624
(4.077)
thal2 2.363
(4.012)
thal3 0.917
(4.014)
Constant 3.305
(4.338)
---------------------------------------------
Observations 303
Log Likelihood -92.893
Akaike Inf. Crit. 219.785
=============================================
Note: *p<0.1; **p<0.05; ***p<0.01
Call:
logitor(formula = heart$target ~ heart$sex + heart$cp + heart$trestbps +
heart$exang + heart$oldpeak + heart$slope + heart$ca + heart$thal,
data = heart)
Odds Ratio:
OddsRatio Std. Err. z P>|z|
heart$sexHomem 0.195629 0.103120 -3.0952 0.0019668 **
heart$cp1 2.802686 1.582803 1.8249 0.0680229 .
heart$cp2 9.208736 4.761942 4.2934 1.760e-05 ***
heart$cp3 12.928636 9.079894 3.6443 0.0002681 ***
heart$trestbps 0.978134 0.010688 -2.0232 0.0430511 *
heart$exangSim 0.426414 0.186184 -1.9521 0.0509254 .
heart$oldpeak 0.618969 0.143209 -2.0733 0.0381420 *
heart$slope1 0.403836 0.334180 -1.0957 0.2731889
heart$slope2 2.015315 1.807384 0.7814 0.4345696
heart$ca1 0.094881 0.047316 -4.7227 2.328e-06 ***
heart$ca2 0.044628 0.033632 -4.1260 3.691e-05 ***
heart$ca3 0.103565 0.093278 -2.5176 0.0118145 *
heart$ca4 3.428663 5.560511 0.7598 0.4473933
heart$thal1 13.792123 56.233616 0.6436 0.5198358
heart$thal2 10.622849 42.620626 0.5890 0.5558877
heart$thal3 2.501108 10.040460 0.2284 0.8193656
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Intercept) heart$sexHomem heart$cp1 heart$cp2 heart$cp3
27.23593767 0.19562852 2.80268560 9.20873636 12.92863623
heart$trestbps heart$exangSim heart$oldpeak heart$slope1 heart$slope2
0.97813449 0.42641389 0.61896935 0.40383558 2.01531468
heart$ca1 heart$ca2 heart$ca3 heart$ca4 heart$thal1
0.09488072 0.04462831 0.10356505 3.42866345 13.79212278
heart$thal2 heart$thal3
10.62284912 2.50110769
RAZÃO DE CHANCE
Observa-se que os valores estimados mostram os coeficientes em formato logarítmo de chances. Sendo assim, devemos efetuar uma exponenciação das variáveis estimadas do modelo.
Então o modelo ficará assim:
Diagnóstico = 27.2359 + 0.1956 x (sex = Homem) + 2.8027 x (CP=1) + 9.2087 x (CP=2) + 12.9286 x (CP=3) + 0.9781 x trestbps + 0.4264 x (exang=Sim) + 0.619 x oldpeak + 0.4038 x (slope=1) + 2.0153 x (slope=2) + 0.0949 x (ca=1) + 0.0446 x (ca=2) + 0.1035 x (ca=3) + 3.4287 x (ca=4) + 13.7921 x (thal=1) + 10.6228 x (thal=2) + 2.5011 x (thal=3)
INTERPRETAÇÃO
- Sendo do sexo masculino, diminuem-se as chances em 80,44% de o paciente possuir doenças do coração;
- Tendo angina atípica, aumentam-se as chances em 180% de o paciente possuir doenças do coração;
- Não tendo dor anginal, aumentam-se as chances em 821% de o paciente possuir doenças do coração;
- Sendo assintomático com relação à dor no peito, aumentam-se as chances em 1293%% de o paciente possuir doenças do coração;
- Para uma alteração em 1 unidade na pressão arterial em repouso, a chance de que o paciente tenha doenças do coração diminui em 2,19%;
- Para quem tem angina induzida pelo exercício, diminuem-se as chances em 57,36% de o paciente possuir doenças do coração;
- Para uma alteração em 1 unidade na Depressão ST induzida por exercício, a chance de que o paciente tenha doenças do coração diminui em 38,1%;
- Para quem tem inclinação do segmento ST plana, diminuem-se as chances em 59,62% de o paciente possuir doenças do coração;
- Para quem tem inclinação do segmento ST para baixo, aumentam-se as chances em 102% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 1, diminuem-se as chances em 90,51% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 2, diminuem-se as chances em 95,54% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 3, diminuem-se as chances em 89,65% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 4, aumentam-se as chances em 243% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 1, aumentam-se as chances em 1280% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 2, aumentam-se as chances em 962% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 3, aumentam-se as chances em 150% de o paciente possuir doenças do coração;
Portanto, as variáveis que influenciam no aumento de doenças do coração são:
- CP: O tipo de dor no peito 1, 2 e 3;
- slope: a inclinação do segmento ST do pico do exercício do tipo 2;
- ca: o número de vasos principais coloridos por flourosopy igual a 4;
- thal: Talassemias tipo 1, 2 e 3.
heart$sexHomem heart$cp1 heart$cp2 heart$cp3 heart$trestbps
18.22289 13.31536 16.58435 10.48333 11.09158
heart$exangSim heart$oldpeak heart$slope1 heart$slope2 heart$ca1
12.70708 21.79372 51.57320 60.68575 12.69705
heart$ca2 heart$ca3 heart$ca4 heart$thal1 heart$thal2
18.87453 15.15317 12.93371 281.45212 1208.21342
heart$thal3
1157.44037
[1] 179.6307
[1] 320.0278
MULTICOLINEARIDADE
Para finalizar, verificamos se existia alguma relação entre as variavéis explicativas. E concluímos que não, pois todos os índices foram superiores a 10. Portanto, as variáveis não são colineares.
A deviance do modelo foi de 179,6307 e o valor crítico do teste de quiquadrado foi de 320,0278. Como a deviance foi menor que o valor crítico, temos que o modelo está bem ajustado.
---
title: "Dashboard Análise heart"
author: "Andressa de Souza Freitas"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
source_code: embed
social: menu
navbar:
- {title: "Linkedin", href: "https://www.linkedin.com/in/andressa-de-souza-freitas-697195177/", align:
rigth }
theme: united
---
```{r setup, include=FALSE}
# Mudando o Diretório de trabalho
setwd("C:/Users/Andressa/Desktop/TRABALHO/PROJETOS/PORTIFÓLIO/Análise_Heart")
# Instalando os pacotes para o projeto (Obs.: Importo todos que conheço, porque estou aprendendo a usar cada um, então ainda não sei direito para que serve exatamente cada um.)
listofPackages <- c("dplyr","stringr","lubridate","ggplot2","ggthemes",
"tidyr","readr","xaringan","tidyverse","data.table", "mfx",
"Amelia","caret","reshape","randomForest","e1071", "faraway",
"rmarkdown", "flexdashboard", "shiny", "plotly", "DT", "plyr", "stargazer",
"RColorBrewer","naniar", "ROCR","svglite","mice", "ResourceSelection", "modEVA")
# # packages <- function(listofPackages){
# new.packages <- listofPackages[!(listofPackages %in% installed.packages()[, "Package"])]
# if (length(new.packages))
# install.packages(new.packages, dependencies = TRUE)
# sapply(listofPackages, require, character.only = TRUE)
# }
#
# lapply(listofPackages, library, character.only = TRUE)
# packages(listofPackages)
# Carregando os pacotes (Sei que gasta memória, também, carregar todos de uma vez, mas com tempo vou pegando as maldades e retirando os que não vou precisar.)
lapply(listofPackages, require, character.only = TRUE)
# Importando o banco de dados
heart <- fread("heart.csv", head = T, sep = ",", dec=".", encoding = 'UTF-8')
```
# Visualização dos dados {data-icon="fa-signal" data-navmenu="Manipulação dos Dados"}
## column {data-width=500}
-----------------------------------------------------------------------
### Conhecendo o banco de dados "heart"
```{r}
DT::datatable(heart[1:303, c(14, 1:13)], rownames = FALSE)
```
## column {data-width=500}
-----------------------------------------------------------------------
```{r message=FALSE, warning=FALSE, paged.print=FALSE, include=FALSE}
# Visualizando os dados e sua estrutura
str(heart)
```
> **INTRODUÇÃO**
>
>
> Este estudo tem como objetivo identificar os fatores que influenciam na presença de doenças do coração. A princípio, iremos fazer uma análise descritiva para termos uma visão mais detalhada do banco e, em seguida iremos fazer uma Análise de Regressão Logística, pois a variável respota diagnóstico (target) é uma variável binária (do tipo 0 ou 1, que nesse caso, representa saudável (0) ou doente (1)).
>
> O banco de dados "heart" possui 303 observações e 14 variáveis.
>
> **Descrição do banco heart:**
>
- age (Idade): variando de 29 a 77 anos;
- sex (sexo): Homem (1) e Mulher (0);
- cp (tipo de dor no peito): varia 0 a 3, sendo angina típica, angina atípica, sem dor anginal e assintomático, respectivamente;
- trestbps (pressão arterial em repouso): medida em mm Hg na admissão no hospital;
- chol (nível de colesterol sérico): medida em mg / dl;
- fbs (concentração de açúcar no sangue em jejum & gt): 1 = verdadeiro; 0 = falso, 120 mg / dl;
- restecg (resultados eletrocardiográficos em repouso): 0 a 2, sendo Normal, com onda ST-T anormal e mostrando provável (ou definida) hipertrofia do ventrículo esquerdo, respectivamente ;
- thalach: frequência cardíaca máxima alcançada;
- exang (angina induzida pelo exercício): 1 = sim; 0 = não;
- oldpeak: Depressão ST induzida por exercício em relação ao repouso;
- slope (a inclinação do segmento ST do pico do exercício): varia de 0 a 2, Inclinado para cima, Plano e Inclinado para baixo, respectivamente;
- ca (número de vasos principais (0-4) coloridos por flourosopy): varia de 0 a 4;
- thal (Talassemias): 3 = normal; 6 = defeito fixo; 7 = defeito reversível;
- target (objetivo/diagnóstico): 0 = Saudável; 1 = Doente.
# Transformação e limpeza dos dados {data-icon="fa-signal" data-navmenu="Manipulação dos Dados"}
## Sidebar {.sidebar}
**TRATAMENTO DOS DADOS**
Nem todos os dados foram reconhecidos pelo R Studio da forma como deveriam com relação ao seus tipos. Praticamente todos os dados foram reconhecidos com se fossem do tipo inteiro. Então, precisamos alterar o tipo desses dados para o tipo correto.
Nesta transformação foram feitas as seguintes mudanças:
- A variável sexo deixou de ser 0 e 1 e passou a ser "Mulher" e "Homem", nesta ordem;
- A variável cp foi trasnformada em fator;
- A variável fbs deixou de ser 0 e 1 e passou a ser "Falso" e "Verdadeiro";
- A variável restecg foi trasnformada em fator;
- A variável exang deixou de ser 0 e 1 e passou a ser "Não" e "Sim";
- As variáveis slope, ca e thal foram transformadas em fator, e;
- A variável target deixou de ser 0 e 1 passou ser "Saudável" e "Doente";
```{r, include=FALSE}
sapply(heart, function(x) sum(is.na(x)))
```
column {data-width=500}
-----------------------------------------------------------------------
### Verificando valores missing
```{r}
missmap(heart, main = "Valores Missing Observados")
```
> Podemos observar atráves do gráfico que não há dados faltantes.
```{r, include=FALSE}
# Convertendo os atributos sex, cp, fbs, restecg, slope, ca, thal e target.
heart <- heart %>%
mutate(sex = cut(sex, c(-1,0,1), labels = c("Mulher", "Homem")),
cp = as.factor(cp),
fbs = cut(fbs, c(-1,0,1), labels = c("Falso", "Verdadeiro")),
restecg = as.factor(restecg),
exang = cut(exang, c(-1,0,1), labels = c("Não", "Sim")),
slope = as.factor(slope),
ca = as.factor(ca),
thal = as.factor(thal),
target = cut(target, c(-1,0,1), labels = c("Saudável", "Doente")))
# Inserindo nova coluna "Categ_Idade"
heart = heart %>%
mutate(Categ_Idade = factor(case_when(age > 0 & age <= 30 ~ "Jovem",
age > 30 & age <= 50 ~ "Adulto",
age >= 50 ~ "Idoso"), levels = c("Jovem", "Adulto", "Idoso")))
heart %>% head()
```
column {data-width=500}
-----------------------------------------------------------------------
### Dados após as transformações
```{r}
DT::datatable(heart[1:303, c(14, 1:13)], rownames = FALSE)
```
# Análise Descritiva das Variáveis Categóricas 1 {data-icon="fa-signal" data-navmenu="Análise Descritiva"}
## Sidebar {.sidebar}
**DESCREVENDO OS DADOS:**
- Idade (age): 68,65% dos pacientes são idosos, 31,02% são adultos e 0,33% é jovem.
- Sexo (sex): 68,32% são homens e 31,68% são mulheres.
- Tipo de dor no peito (cp): 47,19% possuem angina típica (0) 28,71% não possuem dor anginal (2), 16,5% possuem angina atípica (1) e, 7,59% são ssintomáticos (3)
- Concentração de açúcar no sangue (fbs): 85,15% dos pacientes deram falso e 14,85% deram verdadeiro para fbs.
```{r, include=FALSE}
# Funções de tabelas
# Tabela de frequência
tabFreqCat <- function(x){
a = table(x)
b = round(prop.table(a) *100, 2)
return(b)
}
# Tabela Descritiva
tabelaFreq <- function(x){
tabela = data.frame(Minimo = quantile(x)[1],
Quartil1 = quantile(x)[2],
Quartil2 = quantile(x)[3],
Media = round(mean(x), 2),
Desvio = round(sd(x), 2),
Quartil3 = quantile(x)[4],
Maximo = quantile(x)[5],
row.names = NULL)
return(tabela)
}
```
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
```{r, include=FALSE}
# Tabela de frequência da Idade
tb_Idade = rbind(tabFreqCat(heart$Categ_Idade)); tb_Idade
```
### Idade
```{r}
# Gráfico
graf_Idade <- ggplot(data = heart,
aes(x = Categ_Idade)) +
geom_bar(fill = "#00bfa5") +
labs(x = "Categoria de Idade",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por Idade")
graf_Idade
```
```{r, include=FALSE}
# Tabela de frequência da variável Sexo
tb_Sexo = rbind(tabFreqCat(heart$sex)); tb_Sexo
```
### Sexo
```{r}
# Gráfico
graf_Sexo <- ggplot(data = heart,
aes(x = sex)) +
geom_bar(fill = "#00bfa5") +
labs(x = "Sexo",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por Sexo")
graf_Sexo
```
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
```{r, include=FALSE}
# Tabela de frequência da variável Tipo de dor no peito (cp)
tb_cp = rbind(tabFreqCat(heart$cp)); tb_cp
```
### Tipo de dor no peito (cp)
```{r}
# Gráfico
graf_cp <- ggplot(data = heart,
aes(x = cp)) +
geom_bar(fill = "#00bfa5") +
labs(x = "cp",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por CP")
graf_cp
```
```{r, include=FALSE}
# Tabela de frequência da variável açúcar no sangue em jejum & gt (fbs)
tb_fbs = rbind(tabFreqCat(heart$fbs)); tb_fbs
```
### Açúcar no sangue em jejum & gt (fbs)
```{r}
# Gráfico
graf_fbs <- ggplot(data = heart,
aes(x = fbs)) +
geom_bar(fill = "#00bfa5") +
labs(x = "fbs",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por fbs")
graf_fbs
```
# Análise Descritiva das Variáveis Categóricas 2 {data-icon="fa-signal" data-navmenu="Análise Descritiva"}
## Sidebar {.sidebar}
**DESCREVENDO OS DADOS:**
- Resultado da eletrocardiografia em repouso (restecg): 50,17% dos pacientes possuem onda ST-T anormal (1), 48,51% são normais (0), e 1,32% mostram provável (ou definida) hipertrofia do ventrículo esquerdo (2).
- Angina induzida por exercício (exang): 67,33% dos pacientes não apresentaram angina induzida por exercício e 32,67%, sim.
- Inclinação da extremidade do segmento ST no exercício (slope): 46,86% dos pacientes apresentaram inclinação para baixo (2), 46,2% apresentaram inclinação plana (1) e 6,93% apresentaram inclinação para cima (0).
- Número de vasos coloridos pela fluoroscopia (ca): 57,76% dos pacientes não tiveram nenhum vaso colorido (0), 21,45% tiveram 1 vaso colorido, 12,54% tiveram 2 vasos coloridos, 6,6% tiveram 3 vasos coloridos e 1,65% tiveram 4 vasos coloridos.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
```{r, include=FALSE}
# Tabela de frequência da variável resultados eletrocardiográficos em repouso (restecg)
tb_restecg = rbind(tabFreqCat(heart$restecg)); tb_restecg
```
### Resultados eletrocardiográficos em repouso (restecg)
```{r}
# Gráfico
graf_restecg <- ggplot(data = heart,
aes(x = restecg)) +
geom_bar(fill = "#00bfa5") +
labs(x = "restecg",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por restecg")
graf_restecg
```
```{r, include=FALSE}
# Tabela de frequência da variável angina induzida pelo exercício (exang)
tb_exang = rbind(tabFreqCat(heart$exang)); tb_exang
```
### Angina induzida pelo exercício (exang)
```{r}
# Gráfico
graf_exang <- ggplot(data = heart,
aes(x = exang)) +
geom_bar(fill = "#00bfa5") +
labs(x = "exang",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por exang")
graf_exang
```
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
```{r, include=FALSE}
# Tabela de frequência da variável inclinação do segmento ST do pico do exercício (slope)
tb_slope = rbind(tabFreqCat(heart$slope)); tb_slope
```
### Inclinação do segmento ST do pico do exercício (slope)
```{r}
# Gráfico
graf_slope <- ggplot(data = heart,
aes(x = slope)) +
geom_bar(fill = "#00bfa5") +
labs(x = "slope",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por slope")
graf_slope
```
```{r, include=FALSE}
# Tabela de frequência da variável número de vasos principais (0-3) coloridos por flourosopy (ca)
tb_ca = rbind(tabFreqCat(heart$ca)); tb_ca
```
### Número de vasos principais (0-4) coloridos por flourosopy (ca)
```{r}
# Gráfico
graf_ca <- ggplot(data = heart,
aes(x = ca)) +
geom_bar(fill = "#00bfa5") +
labs(x = "ca",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por ca")
graf_ca
```
# Análise Descritiva das Variáveis Categóricas 3 {data-icon="fa-signal" data-navmenu="Análise Descritiva"}
## Sidebar {.sidebar}
**DESCREVENDO OS DADOS:**
- Talassemias (Thal): 54,79% dos pacientes apresentam talassemia de nível 2; 38,61% de nível 3; 5,94% de nível 1 e; 0,66% não apresentam.
- Diagnóstico (target): 54,46% dos pacientes apresentam alguma doença do coração, ou seja, estão doentes e; 45,46% estão estão saudáveis.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
```{r, include=FALSE}
# Tabela de frequência da variável thal
tb_thal = rbind(tabFreqCat(heart$thal)); tb_thal
```
### Talassemias (Thal)
```{r}
# Gráfico
graf_thal <- ggplot(data = heart,
aes(x = thal)) +
geom_bar(fill = "#00bfa5") +
labs(x = "thal",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por Talassemias")
graf_thal
```
```{r, include=FALSE}
# Tabela de frequência da variável objetivo (target)
tb_target = rbind(tabFreqCat(heart$target)); tb_target
```
### Diagnóstico (target)
```{r}
# Gráfico
graf_target <- ggplot(data = heart,
aes(x = target)) +
geom_bar(fill = "#00bfa5") +
labs(x = "target",
y = "Frequência absoluta",
caption = "Fonte: kaggle") +
ggtitle("Contagem de pessoas por diagnóstico")
graf_target
```
# Análise Descritiva das Variáveis numéricas 1 {data-icon="fa-signal" data-navmenu="Análise Descritiva"}
## Sidebar {.sidebar}
**DESCREVENDO OS DADOS NUMÉRICOS:**
**ANALISANDO A PRESSÃO ARTERIAL POR SEXO E IDADE**
- A maioria das pacientes do sexo feminino, dessa amostra, possui pressão arterial entre 120 e 150 e, do sexo masculino possui entre 120 e 140. Tendo uma paciente, chegado a pressão de 200. Os dados mostram que essas pacientes mulheres parecem possuir pressões mais altas que os homens.
- O Histograma de Pressão por Idade mostra que pessoas Idosas, também tendem a ter uma pressão mais elevada do que pessoas mais novas. A categoria adulto tende a possuir pressão arterial entre 110 e 140 e; pessoas idosas entre 120 e 150, também, porém podendo chegar a 200.
**ANALISANDO O COLESTEROL POR SEXO E IDADE**
- O histograma de colesterol por sexo mostra que as pacientes mulheres possuem colesterol entre 200 e 270, em sua maioria; e os homens entre 200 e 250.
- O histograma de colesterol por idade mostra a maior parte dos idosos possuem colesterol entre 200 e 290; e os adultos entre 200 e 270.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Pressão arterial em repouso (trestbps)
```{r}
# Tabela descritiva da variável pressão arterial em repouso (trestbps)
tbtrestbps <- cbind(tabelaFreq(heart$trestbps))
DT::datatable(tbtrestbps , options = list(pageLength = 5))
```
> Os pacientes possuem pressão arterial média de 131,62, com mediana igual a 130. Além disso, a pressão desses pacientes da amostra possuem um valor mínimo de 94 e máximo de 200.
### Pressão arterial por Sexo (trestbps)
```{r}
# Histograma por sexo
graf_trestbps <- heart %>%
filter( trestbps<300 ) %>%
ggplot( aes(x=trestbps, fill=sex)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
#scale_fill_manual(values=c("#404080", "#69b3a2")) +
ggtitle("Histograma Pressão Arterial por Sexo") +
theme(
plot.title = element_text(size=15)
)
graf_trestbps
```
### Pressão arterial por Idade (trestbps)
```{r}
# Histograma por Idade
graf_trestbps2 <- heart %>%
filter( trestbps<300 ) %>%
ggplot( aes(x=trestbps, fill=Categ_Idade)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
#scale_fill_manual(values=c("#404080", "#69b3a2")) +
ggtitle("Histograma Pressão Arterial por Idade") +
theme(
plot.title = element_text(size=15)
)
graf_trestbps2
```
### Teste de Shapiro Wilk
```{r}
shapiro.test(heart$trestbps)
```
> Após fazermos o teste de Shapiro Wilk, verificamos que os dados de pressão arterial não possuem distribuição Normal.Adotamos um nível de significância de 5%.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Colesterol sérico (chol)
```{r}
tbchol <- cbind(tabelaFreq(heart$chol))
DT::datatable(tbchol , options = list(pageLength = 5))
```
> Os pacientes possuem colesterol médio de 246,26, com mediana igual a 240. Além disso, o nível de colesterol desses pacientes da amostra possuem um valor mínimo de 126 e máximo de 564.
### Histograma colesterol por idade por Sexo
```{r}
# Histograma por sexo
graf_chol <- heart %>%
filter( chol<300 ) %>%
ggplot( aes(x=chol, fill=sex)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma do nível de colesterol por sexo") +
theme(
plot.title = element_text(size=15)
)
graf_chol
```
### Histograma colesterol por idade por Idade
```{r}
# Histograma por Idade
graf_chol2 <- heart %>%
filter( chol<300 ) %>%
ggplot( aes(x=chol, fill=Categ_Idade)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma do nível de colesterol por Idade") +
theme(
plot.title = element_text(size=15)
)
graf_chol2
```
> Adicionar comentário
### Teste de Shapiro Wilk para chol
```{r}
shapiro.test(heart$chol)
```
> Pelo teste de Shapiro Wilk, podemos afirmar que a distribuição desses dados, também, não é Normal.
# Análise Descritiva das Variáveis numéricas 2 {data-icon="fa-signal" data-navmenu="Análise Descritiva"}
## Sidebar {.sidebar}
**ANALISANDO A FREQUÊNCIA CARDÍACA MÁXIMA POR SEXO E IDADE:**
- O histograma de Frequência Cardíaca máxima por sexo mostra que as mulheres possuem uma frequência cardíaca entre 150 e 170. Já os homens possuem uma frequência cardíaca entre 140 e 170. As mulheres parecem possuir frequência cardíaca mámixa mai alta.
- O histograma de Frequência Cardíaca por Idade mostra que a categoria adulto possui frequência cardíaca máxima mais alta com relação aos idosos. E o único jovem da amostra possui a frequência cardíaca máxima de 200, que é o valor mais alto da amostra.
**ANALISANDO A DEPRESSÃO ST (INDUZIDA POR EXERCÍCIO) POR SEXO E IDADE:**
- O histograma de depressão induzida por exercício, por sexo, mostra que mulheres e homens parecem possuir valores similares de depressão, que varia entre -5 e 5. Exceto por um outlier do sexo masculino que contém na amostra que ultrapassa esse valor, podendo chegar ao intervalo de 5 a 15.
- O histograma de depressão induzida por exercício, por idade, mostra que mulheres e homens parecem possuir valores similares de depressão, que varia entre -5 e 5. Exceto por um outlier da categoria Idoso, que contém na amostra, e ultrapassa esse valor, podendo chegar ao intervalo de 5 a 15.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Frequência cardíaca máxima alcançada (thalach)
```{r}
tbthalach <- cbind(tabelaFreq(heart$thalach))
DT::datatable(tbthalach , options = list(pageLength = 5))
```
> Os pacientes possuem uma frequência cardíaca média de 149,65; com mediana de 153 e; frequência cardíaca mínima de 71 e máxima de 202.
### Histograma Frequência cardíaca por sexo
```{r}
# Histograma por Sexo
graf_thalach <- heart %>%
filter( thalach<300 ) %>%
ggplot( aes(x=thalach, fill=sex)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma de Frequência Cardíaca por Sexo") +
theme(
plot.title = element_text(size=15)
)
graf_thalach
```
### Histograma Frequência cardíaca por Idade
```{r}
# Histograma por Idade
graf_thalach2 <- heart %>%
filter( thalach<300 ) %>%
ggplot( aes(x=thalach, fill=Categ_Idade)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma de Frequência Cardíaca por Idade") +
theme(
plot.title = element_text(size=15)
)
graf_thalach2
```
### Teste de Shapiro Wilk para thalach
```{r}
shapiro.test(heart$thalach)
```
> O teste de Shapiro Wilk mostra que os dados dessa variável não possui distribuição normal.
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Depressão ST induzida por exercício em relação ao repouso (oldpeak)
```{r}
tboldpeak <- cbind(tabelaFreq(heart$oldpeak))
DT::datatable(tboldpeak , options = list(pageLength = 5))
```
> Os pacientes possuem uma Depressão ST induzida por exercício média de 1,04; com mediana de 0,8 e; mínima de 0 e máxima de 6,2.
### Histograma Depressão ST induzida por Sexo
```{r}
# Histograma por sexo
graf_oldpeak <- heart %>%
filter( oldpeak<300 ) %>%
ggplot( aes(x=oldpeak, fill=sex)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma da Depressão ST induzida por Sexo") +
theme(
plot.title = element_text(size=15)
)
graf_oldpeak
```
### Histograma Depressão ST induzida por Idade
```{r}
# Histograma por Idade
graf_oldpeak2 <- heart %>%
filter( oldpeak<300 ) %>%
ggplot( aes(x=oldpeak, fill=Categ_Idade)) +
geom_histogram( binwidth=10, color="#e9ecef", alpha=0.5, position = "identity") +
ggtitle("Histograma da Depressão ST induzida por Idade") +
theme(
plot.title = element_text(size=15)
)
graf_oldpeak2
```
### Teste de Shapiro Wilk para oldpeak
```{r}
shapiro.test(heart$oldpeak)
```
> Os dados da variável oldpeak não são normais.
# Verificando a influência das variáveis {data-icon="fa-signal" data-navmenu="Análise de Regressão Logística"}
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Ajustando o modelo com todas as variáveis
```{r}
target_logit <- glm(heart$target ~ heart$age + heart$sex + heart$cp
+ heart$trestbps + heart$chol + heart$fbs + heart$restecg
+ heart$thalach + heart$exang + heart$oldpeak + heart$slope
+ heart$ca + heart$thal, data = heart, family = "binomial"); target_logit
```
> **REGRESSÃO LOGÍSTICA MÚLTIPLA**
>
"A técnica de regressão logística é uma ferramenta estatística utilizada nas análises preditivas. O interesse em mensurar a probabilidade de um evento ocorrer é extremamente relevante em diversas áreas...". Nesse estudo, gostaríamos de saber quais são os fatores que mais influenciam na presença de doenças do coração.
>
**O MODELO**
>
O modelo de regressão logística é utilizado quando a variável dependente é binária. Então, primeiramente, verificamos que o tipo da variável resposta era uma binomial do tipo Saudável = 0 e Doente = 1. Para a estimação dos coeficientes das variáveis independentes, serão utilizados o valor logit. Então, o modelo inicial ficou assim:
>
Diagnóstico = 0.179045 + 0.027819 x Age - 1.862297 x (Sex=Homem) + 0.864708 x (CP=1) + 2.003186 x (CP=2) + 2.417107 x (CP=3) - 0.026162 x trestbps - 0.004291 x chol + 0.445666 x (fbs=verdadeiro) + 0.460582 x (restecg=1) - 0.714204 x (restecg=2) + 0.020055 x thalach - 0.779111 x (exang=Sim) - 0.397174 x oldpeak - 0.775084 x (slope=1) + 0.689965 x (slope=2) - 2.342301 x (ca=1) - 3.483178 x (ca=2) - 2.247144 x (ca=3) + 1.267961 x (ca=4) + 2.637558 x (thal=1) + 2.367747 x (thal=2) + 0.915115 x (thal=3)
>
>
### Descrição do modelo 1
```{r}
summary(target_logit)
```
> **VARIÁVEIS SIGNIFICATIVAS**
>
Verificamos quais eram as variáveis mais siginificativas no modelo ao nível de significância de 5%, são elas: Sexo Masculino, o tipo de dor no peito (cp = 2 e 3, ou seja, sem dor anginal e assintomático), a pressão arterial medida em repouso e, o número de vasos principais coloridos por flourosopy (ca = 1, 2 e 3).
>
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Verificando o Ajuste do Modelo
```{r}
confint(target_logit)
# Deviance: 179.3269
target_logit$deviance
d_critico = qchisq(0.95,df=target_logit$df.residual); d_critico
# Como o valor da deviance é menor que o valor critico temos que o modelo esta bem ajustado.
```
> **AJUSTE DO MODELO**
>
A deviance do modelo foi de 179,6307 e foi menor que o valor do quiquadrado que foi de 320,0278. Portanto, ao nível de significância de 5%, podemos dizer que o modelo está bem ajustado.
>
Acima, também podemos observar os intervalos de confiança dos coeficientes estimados das variáveis explicativas. Os intervalos que não passam pelo zero são os das variáveis significativas. E podemos ver que são exatamente as mesmas variáveis significativas que descrevemos, anteriormente.
>
### Teste Hosmer-Lemeshow
```{r}
# Teste Hosmer-Lemeshow: Como o p-valor foi menor que 0,05, rejeita-se a hipótese
# de que as proporções observadas e esperadas são as mesmas ao longo da amostra, o modelo está mal ajustado.
hoslem.test(heart$target, fitted(target_logit), g=10)
```
> **TESTE DE HOSMER-LEMESHOW**
>
O teste de Hosmer-Lemeshow é para verificar se as proporções observadas e esperadas são as mesmas ao longo da amostra. Como o p-valor foi menor que 0,05, rejeita-se a hipótese nula, ou seja, o modelo está tendo problemas.
>
# Encontrando o melhor modelo {data-icon="fa-signal" data-navmenu="Análise de Regressão Logística"}
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Método Stepwise
```{r}
# Método Stepwise: Quanto menor o AIC, melhor o ajuste do modelo.
step(target_logit, direction = 'both')
```
> **MÉTODO STEPWISE**
>
O método Stepwise nos auxilia a selecionar as variáveis mais importantes para nosso modelo. *Este método, por sua vez, utiliza o Critério de Informação de Akaike (AIC - Akaike Information Criterion) na combinação das variáveis dos diversos modelos simulados para selecionar o modelo mais ajustado. Quanto menor o AIC, melhor o ajuste do modelo.* Utilizaremos neste modelo a direção *both*.
>
> **ENCONTRANDO O MELHOR MODELO**
>
Após analisarmos os AIC's, escolhemos o menor para usar, com valor de 219,8 e Residual Deviance de 185.8. Daí, o novo modelo ficou assim:
>
Diagnóstico = 3.30454 - 1.63154 x (sex = Homem) + 1.03058 x (CP=1) + 2.22015 x (CP=2) + 2.55944 x (CP=3) - 0.02211 x trestbps - 0.85234 x (exang=Sim) - 0.47970 x oldpeak - 0.90675 x (slope=1) + 0.70078 x (slope=2) - 2.35513 x (ca=1) - 3.10939 x (ca=2) - 2.26756 x (ca=3) + 1.23217 x (ca=4) + 2.62410 x (thal=1) + 2.36301 x (thal=2) + 0.91673 x (thal=3)
>
### Melhor modelo
```{r}
# Melhor modelo:
modelo = glm(heart$target ~ heart$sex + heart$cp + heart$trestbps + heart$exang +
heart$oldpeak + heart$slope + heart$ca + heart$thal, data = heart, family = "binomial"); modelo
```
```{r}
```
column {data-width=500} {.tabset}
-----------------------------------------------------------------------
### Calculando a Razão de chances (odds ratio - OR)
```{r}
# Calculando a Razão de chances (odds ratio - OR)
stargazer(modelo, title="Resultados",type = "text")
logitor(heart$target ~ heart$sex + heart$cp + heart$trestbps + heart$exang +
heart$oldpeak + heart$slope + heart$ca + heart$thal,data=heart)
exp(coef(modelo))
```
> **RAZÃO DE CHANCE**
>
Observa-se que os valores estimados mostram os coeficientes em formato logarítmo de chances. Sendo assim, devemos efetuar uma exponenciação das variáveis estimadas do modelo.
>
Então o modelo ficará assim:
>
Diagnóstico = 27.2359 + 0.1956 x (sex = Homem) + 2.8027 x (CP=1) + 9.2087 x (CP=2) + 12.9286 x (CP=3) + 0.9781 x trestbps + 0.4264 x (exang=Sim) + 0.619 x oldpeak + 0.4038 x (slope=1) + 2.0153 x (slope=2) + 0.0949 x (ca=1) + 0.0446 x (ca=2) + 0.1035 x (ca=3) + 3.4287 x (ca=4) + 13.7921 x (thal=1) + 10.6228 x (thal=2) + 2.5011 x (thal=3)
> **INTERPRETAÇÃO**
>
- Sendo do sexo masculino, diminuem-se as chances em 80,44% de o paciente possuir doenças do coração;
- Tendo angina atípica, aumentam-se as chances em 180% de o paciente possuir doenças do coração;
- Não tendo dor anginal, aumentam-se as chances em 821% de o paciente possuir doenças do coração;
- Sendo assintomático com relação à dor no peito, aumentam-se as chances em 1293%% de o paciente possuir doenças do coração;
- Para uma alteração em 1 unidade na pressão arterial em repouso, a chance de que o paciente tenha doenças do coração diminui em 2,19%;
- Para quem tem angina induzida pelo exercício, diminuem-se as chances em 57,36% de o paciente possuir doenças do coração;
- Para uma alteração em 1 unidade na Depressão ST induzida por exercício, a chance de que o paciente tenha doenças do coração diminui em 38,1%;
- Para quem tem inclinação do segmento ST plana, diminuem-se as chances em 59,62% de o paciente possuir doenças do coração;
- Para quem tem inclinação do segmento ST para baixo, aumentam-se as chances em 102% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 1, diminuem-se as chances em 90,51% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 2, diminuem-se as chances em 95,54% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 3, diminuem-se as chances em 89,65% de o paciente possuir doenças do coração;
- Para quem tem número de vasos principais coloridos por flourosopy iguais a 4, aumentam-se as chances em 243% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 1, aumentam-se as chances em 1280% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 2, aumentam-se as chances em 962% de o paciente possuir doenças do coração;
- Para quem possui Talassemias iguais a 3, aumentam-se as chances em 150% de o paciente possuir doenças do coração;
> Portanto, as variáveis que influenciam no aumento de doenças do coração são:
>
- CP: O tipo de dor no peito 1, 2 e 3;
- slope: a inclinação do segmento ST do pico do exercício do tipo 2;
- ca: o número de vasos principais coloridos por flourosopy igual a 4;
- thal: Talassemias tipo 1, 2 e 3.
>
### Verificando Multicolinearidade e se o modelo está bem ajustado
```{r}
# Verificando Multicolinearidade (relação entre as variáveis do modelo), índice não deve estar abaixo de 10.
vif(modelo) # O modelo não possui multicolinearidade.
# Deviance:
target_logit$deviance
d_critico = qchisq(0.95,df=target_logit$df.residual); d_critico
# Como o valor da deviance é menor que o valor critico temos que o modelo esta bem ajustado.
```
> **MULTICOLINEARIDADE**
> Para finalizar, verificamos se existia alguma relação entre as variavéis explicativas. E concluímos que não, pois todos os índices foram superiores a 10. Portanto, as variáveis não são colineares.
>
A deviance do modelo foi de 179,6307 e o valor crítico do teste de quiquadrado foi de 320,0278. Como a deviance foi menor que o valor crítico, temos que o modelo está bem ajustado.
>